perm filename MRK.OLD[P11,LCS] blob
sn#583817 filedate 1981-05-05 generic text, type T, neo UTF8
SUBROUTINE MRK
COMMON /INTGRS/JACC,JTAIL,MRK,NTYPE,JSTEM,JWHOLE
COMMON/DAT/RACNT(69),RDT(17),NXAC(7)
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
COMMON /FONT/JFONT /PLTR/IPLT,RHT /POSI/STFF(0/7),JJ2,POS
COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(R11,RJQ(9))
1,(R4,RJQ(2)),(RLVL,RJQ(20)),(R6,RJQ(4)),(J11,JQ(9))
RX=RMINI
RINV=1.0
MRK=J11/100
C GET MARK CLOSEST TO NOTE HEAD.
J5=J11-MRK
R11=AMOD(R11,1.0)*7.*RMINI
C SHIFT AWAY FROM NORMAL VERTICAL POS.
IF(J5.LT.27)GO TO 1
IF(J5.LE.28)CALL EXCH(J5,MRK)
C ALL THIS FOR TEN.-STAC. COMBO (=27) ALSO WEDGE-STAC.
1 R4=RLVL
R3=RJAC
J4=R4
JX=1
CC IF(J5.GT.16)GO TO 2222
C JUMP FOR MORD, INV.MORD, TRILL
1250 RB=14.
IF(MOD(J4,2).EQ.0)GO TO 244
IF(J5.EQ.7)GO TO 6322
IF(J5.NE.9)GO TO 244
6322 IF(JSTEM.GT.1)GO TO 7322
IF(J4.LT.5)GO TO 244
7322 IF(J4.LE.9)GO TO 8322
IF(JSTEM.EQ.2)GO TO 244
IF(JSTEM.EQ.0)GO TO 244
8322 RB=21.
C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
244 IF(JSTEM.EQ.1)GO TO 9322
IF(JSTEM.NE.0)GO TO 245
IF(J4.GE.7)GO TO 245
9322 RB=-RB
245 CENTR=CENTR+RB*RSTJ2
CC245 CENTR=CENTR+RB*RSTX
R11=0
250 IF(J5.GT.10)GO TO 281
IF(J5.LT.6)GO TO 281
JA=9
IF(J5.NE.7)GO TO 253
C 7=DOT
RXX=R3
R3=R3+6.7*RMINI
C CENTERS THE DOT
29 RJY=CENTR+RSTJ2
RG=9.
IF(IPLT.LT.0)RG=17.
CALL RDRAW(1,RG,RDOT,RMINI,R3,RJY,RMINI)
GO TO 6241
253 IF(J5.EQ.9)GO TO 271
C 9=DASH
251 IF(RB.LT.0)RINV=-RINV
2222 IF(R11.EQ.0)GO TO 12222
C FIX THIS!!!! FOR BOWINGS, ETC.
CENTR=CENTR+R11
R4=R4+CENTR/7.
C GET DISPLACEMENT IN SCALE STEPS. ;ADD TO HEIGHT
R11=0
IF(JSTEM.EQ.1)R11=-R11
C FOR WEDGE
RX4=RX4-CENTR/7.
12222 IF(FICTA.NE.0)GO TO 2223
C SKIPE FICTA ;MUSICA FICTA FLAG (J5=21,22,23 SAME AS TR.)
IF(J5.LT.20.OR.J5.GT.23)GO TO 2223
JA=7
R5=0
J7=1
CALL ALPHA
R8=J5-20
C (R8=1=FLT, 2=SHRP, 3=NAT)
C FOR TRILL -- J5=20
RETURN
2223 FICTA=0
IF(J5.EQ.17)GO TO 323
IF(J5.NE.18)GO TO 222
323 RINV=J5
C FOR MORD, INV.MORD
222 CALL FERMTA
GO TO 5241
246 IF(J5.LT.10)GO TO 245
C FOR COMBOS. TS=27, WS=28, AS=29.
IF(J5.LT.27.OR.J5.GT.30)GO TO 1246
TS=J5
C TS IS FLAG FOR COMBOS
J5=7
CC MOVEI 7 ; STACCATO COMES FIRST IN COMBOS
CC JRST ATS
GO TO 1250
C; CAIN =28 ;WS COMBO =28
C; JRST AC246
C; CAIE =27 ;TS COMBO =27
C; JRST AB246 ;IF(J5.NE.27)GO TO AB246
C;AA246: MOVEI =9 ;TEN. COMES 1ST IF TEN.-STAC. COMBO
C; SKIPA
C;AC246: MOVEI =7 ;STAC. COMES 1ST IF WEDGE-STAC. COMBO
C; MOVEM TS ;TS=CODE FLAG
C; JRST ATS ; AC0=9 SETUP TENUTO FIRST
1246 RZ=3
C IS IT A FERMATA?
IF(J5.EQ.26)RZ=2
C RZ=2 **** MAKE FERMATA 1 LESS AWAY
IF(JSTEM.EQ.1)RZ=8.+R8
C IS IT A FERMATA?
26 R4=R4+RZ*RMINI/RSTJ2
RC=12.5
IF(J5.EQ.26)RC=11.75
IF(R4.LT.RC)R4=RC
IF(J5.NE.26)GO TO 28
CENTR=CENTR+R11
GO TO 222
28 IF(J5.LT.30)GO TO 281
C PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
IF(J5.GE.36)GO TO 128
R5=J5-30
C GET THE 1 DIGIT NUM.
RC=6.
IF(JSTEM.NE.2)RC=8.
JX3=JX3+RC*RSTJ2
R7=0
R8=0
R9=0
RA=2.5
IF(JSTEM.EQ.1)RA=4.
R4=J4+RA
C HGT OF NUM.
CALL MAKNUM(R5)
RETURN
C ADD HERE FOR NUMS WITH ACCENTS, ETC.
128 J5X=MOD(J5,10)
C J5X SAVES NEXT MARK.
IF(J5X.LT.4)J5X=0
J5=J5/10
IF(J5.GT.30)RETURN
C WON'T READ 415 ETC. (CORRECT=154)
C DOES BOTTOM MARK FIRST, THEN TOP.
CALL EXCH(J5X,J5)
C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
IF(JA.EQ.1)GO TO 249
1241 IF(J5.GE.11)GO TO 28
GO TO(211,211,211,28,28,222,1250,60,27,27),J5
RETURN
281 JX=1
IF(J5.GT.16)GO TO 2222
C JUMP FOR MORD, INV.MORD, TRILL
IF(J5.NE.4)GO TO 228
JX=5
CALL RJBX(.5)
GO TO 328
228 IF(J5.GT.10)JX=NXAC(J5-10)
C JX IS POINTER IN RACNT ARRAY
328 RA=RMINI
C OR RSTJ2?
IF(RINV.LT.0)GO TO 1323
IF(JSTEM.NE.1)GO TO 2323
IF(J5.NE.4)GO TO 2323
1323 RA=-RA
C ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
2323 JTH=0
IF(IPLT.LT.0)JTH=-2
11 RJJJ=CENTR+R11
C (DISPLACEMENT UNIT)
IF(JX.LT.54)CALL RDRAW(JX+1,RACNT(JX),RACNT,RA,R3,CENTR,RMINI)
C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
IF(JTH.GE.0)GO TO 5241
4241 JJJ=J5
JTH=JTH-1
IF(J5.NE.13)GO TO 127
C 13=HARMONIC
RMINI=RMINI+.02
GO TO 11
127 IF(J5.EQ.14)R3=R3+XDIS
C 14= +
CENTR=CENTR-XDIS
C TO THICKEN > - ∧ ETC. WHEN PLOTTING
GO TO 11
4240 JJJ=J5
C *****WHERE IS JJJ USED????***********
14241 J5=J5X
J5X=-1
IF(JAX.NE.1)GO TO 7241
CC IF(J5.GT.10)GO TO 246
IF(J5.NE.7)GO TO 7241
CC IF(JJJ.NE.9)GO TO 249
7241 RXX=8.5*RMINI
IF(J5.EQ.5)RXX=10.5*RMINI
C ACC. IS FARTHER FROM STAC. THAN WEDGE OR TEN.
C THIS IS FOR COMPOSITE MARKS (TEN.-STAC. ETC)
IF(JSTEM.EQ.1)RXX=-RXX
CENTR=CENTR+RXX
IF(J5.EQ.26)J5=6
CC GO TO 1241
C >=5, ↑=4
27 R3=J3
C DASHES
271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
IF(IPLT.LT.0)CALL LINX(R3,CENTR,TEMP,CENTR)
C MAKE THICKER IF PLOTTING
C CENTR=CENTR-XDIS (1/DIS)
CC GO TO 5240
5241 IF(J11.EQ.0)GO TO 25241
CC IF(TS.LT.0)GO TO 15241
CC IF(TS.EQ.CODE)AC0=7, RESET TS, GO TO B421
CC J5=9
C NOW GET TENUTO (=9)
CC IF(TS.EQ.28)J5=4
C ABOVE IS WEDGE (FOR WS)
CC IF(TS.EQ.29)J5=5
C ACCENT
CC TS=-1
CC GO TO 7241
C GO ARRANGE THE HEIGHT SHIFT
C J11=0 SO IT WILL PASS HERE SECOND TIME AROUND.
C R11=0 SO DOUBLE MARKS WON'T BE MOVED UP TWICE.
CC GO TO 24241
25241 IF(J5X.GT.0)GO TO 14241
C J5X IS FOR DOUBLE MARKS.(WHAT ABOUT DOT POSITION.)
RETURN
6241 R3=RXX
C RESET R3 AFTER A DOT.
GO TO 5241
3121 J5=J5+9
CALL DRWNT
CC GO TO 2422
RETURN
C 4=WDG, 5=ACCNT, 7 STACC, 9=TEN, 11=DNBOW, 12=UPBOW, 13=HARM, 14=+
C 15=THESIS, 16=ARSIS, 17=MORD, 18= INVMORD, 20=TR, 21=Tb, 22=T#, 23=TNAT
C 25=HVYWDG, 26=FERM, 27=TEN-STACC, 28=WDG-STACC, 29=ACCNT-STACC
C 30-35=FINGERING, 21-23=MUSICA FICTA
249 IF(J5.GT.30)GO TO 28
IF(J5.GT.10)GO TO 246
IF(J5.EQ.0)RETURN
GO TO 1250
END